home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / c / qk3tek.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-12-13  |  51.7 KB  |  1,307 lines
  1. Unit Tek4100 ;
  2. (* ------------------------------------------------------------------ *)
  3. (* Tektronics 4100  Graphics emulation unit                           *)
  4. (* ------------------------------------------------------------------ *)
  5. Interface
  6.   Uses Crt,Graph,Printer,    (* Standard Turbo Pascal Units *)
  7.        Fonts,Drivers,        (* Optional Turbo Pascal generated Units *)
  8.        KGlobals,Sysfunc,
  9.        Modempro,Packets;
  10.   Const
  11.     Gversion = ' a' ;
  12.     enq = $05 ;    EQ = #$05 ;
  13.     bel = $07 ;    BL = #$07 ;
  14.     ff_ = $0C ;    FF = #$0C ;
  15.     cr_ = $0D ;    CR = #$0D ;
  16.     etb = $17 ;    EB = #$17 ;
  17.     can = $18 ;    CN = #$18 ;
  18.     sub = $1A ;    SB = #$1A ;
  19.     esc = $1B ;    EC = #$1B ;
  20.     fs_ = $1C ;    FS = #$1C ;
  21.     gs_ = $1D ;    GS = #$1D ;
  22.     rs_ = $1E ;    RS = #$1E ;
  23.     us_ = $1F ;    US = #$1F ;
  24.   Var
  25.     NewGraph : Boolean ;
  26.     Graphics : string [25] ;
  27.     Afile    : file of byte ;
  28.     filename : string[25] ;
  29.     achar    : char ;
  30.  
  31.     Procedure Tektronics (lastbyte : byte) ;
  32.  
  33. Implementation
  34. (* ------------------------------------------------------------------ *)
  35. Type
  36.      screen  = array [0..$7FFF] of byte ;
  37.  
  38. var  (* Tek 4100 variables *)
  39.      tek4010                  : boolean ;
  40.      abyte,bbyte              : byte ;
  41.      result,
  42.      Ysize                    : Integer ;
  43.      BeginPanel               : boolean ;
  44.      BeginPanelX,BeginPanelY,
  45.      LastX,LastY,NewX,NewY,
  46.      XDim,YDim,
  47.      CursorX,CursorY,
  48.      SGPosX,SGPosY,
  49.      X1,X2,Y1,Y2,
  50.      WindowX,WindowY          : integer ;
  51.      Xscale,Yscale            : Real ;
  52.      HiY, LoY, HiX, LoX,
  53.      ExtraY, ExtraX           : byte ;
  54.      NeedLoY,DrawVector       : Boolean ;
  55.  
  56.      GTslant,GTbackindex,
  57.      GTdashindex,GTFont,
  58.      height,
  59.      GTwidth,GTheight,GTspacing,
  60.      PickId,LineIndex,MarkerNumber,
  61.      GTpath,FillPattern,GTprecision,
  62.      Unknown1,Unknown2,Unknown3,
  63.      Mantissa,Exponent,
  64.      TextIndex,LineStyle,
  65.      FixLevel,ErrorLevel,
  66.      GTB_FontNumber,
  67.      SegmentNum,OpenSegment,
  68.      PixSurface,ALUmode,BitsPerPixel,
  69.      DevFunCode,DistanceFilter,TimeFilter,
  70.      ViewNumber,DAlines       : integer ;
  71.      GTrotation               : real ;
  72.      SurfaceNumber,
  73.      ColorCoord1,ColorCoord2,ColorCoord3,
  74.      ColorMode,ColorOverMode,GrayMode,
  75.      ColorMixI,I :integer ;
  76.      ColorMix                 : Array [1..64] of integer ;
  77.      GINColor                 : shortint ;
  78.      GTB_FontChar             : byte ;
  79.      BoundfillPat,
  80.      GINenable ,
  81.      GAmode,DAenable,
  82.      DAvisibility             : boolean ;
  83.      PI                       : integer ;
  84.      alphastr                 : string  ;
  85.      alphacnt                 : integer ;
  86.      GraphDriver,GraphMode    : integer ;
  87.      palette                  : PaletteType ;
  88.      PolyGon                  : array  [1..127] of PointType ;
  89.      GraphScreen,SaveScreen   : ^screen ;
  90.      SaveScreenP              : pointer ;
  91. (* ------------------------------------------------------------------ *)
  92. Procedure CrossHair ( X,Y : integer );
  93. const    CrossX    = 24;
  94.          CrossY    = 10;
  95. var      x1,y1,x2,y2  :  integer;
  96.     begin (* Cross Hair *)
  97.     x1 := X - CrossX;  if x1 < 0 then x1 := 0;
  98.     x2 := X + CrossX;  if x2 >= XDim then x2 := XDim - 1;
  99.     y1 := Y - CrossY;  if y1 < 0 then y1 := 0;
  100.     y2 := Y + CrossY;  if y2 >= Ydim then y2 := YDim - 1;
  101.     for x1 := x1 to x2 do PutPixel(x1,(YDim-Y),GetPixel(x1,(YDim-Y)) xor $0F);
  102.     for y1 := y1 to y2 do PutPixel(X,(YDim-y1),GetPixel(X,(YDim-y1)) xor $0F);
  103.     end ; (* CrossHair *)
  104.  
  105. Procedure Mark( X,Y,Marktype : integer );
  106.          Begin (* Mark  *)
  107.          Case Marktype of
  108.    0:  Begin { Dot }
  109.        line(X,Y,X,Y);
  110.        End ; { Dot }
  111.  
  112.    1:  Begin { Small Cross }
  113.        Line(X,Y-2,X,Y+2);
  114.        Line(X-2,Y,X+2,Y);
  115.        End ; { Small Cross }
  116.  
  117.    2:  Begin { Cross }
  118.        Line(X,Y-3,X,Y+3);
  119.        Line(X-3,Y,X+3,Y);
  120.        End ; { Cross }
  121.  
  122.    3:  Begin { Star  }
  123.        Line(X-2,Y-2,X+2,Y+2);
  124.        Line(X-2,Y+2,X+2,Y-2);
  125.        Line(X,Y-3,X,Y+3);
  126.        End ; { Star  }
  127.  
  128.    4:  Begin { Zero }
  129.        Line(X-1,Y-4,X+1,Y-4);
  130.        Line(X-2,Y-3,X-2,Y+3);
  131.        Line(X+2,Y-3,X+2,Y+3);
  132.        Line(X-1,Y+4,X+1,Y+4);
  133.        End ; { Zero  }
  134.  
  135.    5:  Begin { X }
  136.        Line(X-2,Y-3,X+2,Y+3);
  137.        Line(X-2,Y+3,X+2,Y-3);
  138.        End ; { X }
  139.  
  140.    6:  Begin { Square }
  141.        Line(X-2,Y-2,X+2,Y-2);
  142.        Line(X-2,Y+2,X-2,Y-2);
  143.        Line(X+2,Y-2,X+2,Y+2);
  144.        Line(X-2,Y+2,X+2,Y+2);
  145.        End ; { Square  }
  146.  
  147.    7 : Begin { Diamond }
  148.        Line(X-2,Y,X,Y-2);
  149.        Line(X-2,Y,X,Y+2);
  150.        Line(X,Y-2,X+2,Y);
  151.        Line(X,Y+2,X+2,Y);
  152.        End ; { Diamond  }
  153.  
  154.    8 : Begin { Square and Dot }
  155.        Line(X-2,Y-2,X+2,Y-2);
  156.        Line(X-2,Y+2,X-2,Y-2);
  157.        Line(X+2,Y-2,X+2,Y+2);
  158.        Line(X-2,Y+2,X+2,Y+2);
  159.        Line(X,Y,X,Y);
  160.        End ; { Square and Dot }
  161.  
  162.    9 : Begin { Diamond and Dot }
  163.        Line(X-2,Y,X,Y-2);
  164.        Line(X-2,Y,X,Y+2);
  165.        Line(X,Y-2,X+2,Y);
  166.        Line(X,Y+2,X+2,Y);
  167.        Line(X,Y,X,Y);
  168.        End ; { Diamond and Dot }
  169.  
  170.    10: Begin { Square and cross }
  171.        Line(X-2,Y-2,X+2,Y-2);
  172.        Line(X-2,Y+2,X-2,Y-2);
  173.        Line(X+2,Y-2,X+2,Y+2);
  174.        Line(X-2,Y+2,X+2,Y+2);
  175.        Line(X-1,Y-1,X-1,Y-1);
  176.        Line(X-1,Y+1,X-1,Y+1);
  177.        Line(X+1,Y-1,X+1,Y-1);
  178.        Line(X+1,Y+1,X+1,Y+1);
  179.        End ; { Square and cross }
  180.           End ; (* case marktype *)
  181.          End ; (* Mark  *)
  182.  
  183.  (* ----------------------------------------------------------------- *)
  184.  
  185. (* ****************************************************************** *)
  186. Procedure Tektronics (lastbyte : byte) ;
  187.  Const
  188.     BitCheck = $60 ;
  189.     LoYBit   = $60 ;
  190.     LoXBit   = $40 ;
  191.     HiBit    = $20 ;
  192.     Bit6     = $20 ;
  193.     FiveBits = $1F ;
  194.     pattern : array [0..3] of word  = ($FFF0,$333F,$7FE6,$F0F0);
  195.  Var
  196.     TekState, Done,
  197.     TEK4014LineStyle : boolean ;
  198.     abyte            : byte ;
  199.     achar            : char ;
  200.     Temp,ix          : Integer ;
  201.  Label VectorMode,VectorContinue,exit ;
  202.  
  203.     (* --------------------------------------------------------------- *)
  204.     Procedure GetCoord(var X,Y : integer);
  205.     label exit ;
  206.     BEGIN (* Get X,Y Coordinates *)
  207.     NeedLoY := false ;
  208.     IF (abyte and BitCheck) = HiBit THEN
  209.          Begin (* HiY *)
  210.          HiY := abyte and FiveBits ;
  211.          If ReadMchar(abyte) then else goto exit;
  212.          End ;  (* HiY *)
  213.    IF (abyte and BitCheck) = LoYBit   THEN
  214.          BEGIN  (* LoYBit *)
  215.          LoY := abyte and FiveBits;
  216.          IF  (abyte and $10) = 0 then
  217.               begin (* Assume Extra bits *)
  218.               ExtraX := abyte and $03 ;
  219.               ExtraY := (abyte and $0C) shr 2 ;
  220.               NeedLoY := true ;
  221.               end  (* Assume Extra bits *)
  222.                                   else
  223.               LoY := abyte and FiveBits;
  224.          If ReadMchar(abyte) then else goto exit;
  225.          END ;   (* LoYBit or Extra Bit *)
  226.    IF ((abyte and BitCheck) = LoYBit)   THEN
  227.          BEGIN  (* LoYBit *)
  228.          LoY := abyte and FiveBits;
  229.          NeedLoY := false ;
  230.          If ReadMchar(abyte) then else goto exit ;
  231.          End    (* LoYBit *)
  232.                                       ELSE
  233.          If NeedLoY  then
  234.               Begin  {Extra bit was really LoY bits }
  235.               NeedLoY := false ;
  236.               ExtraX := 0 ;
  237.               ExtraY := 0 ;
  238.               End ;
  239.       IF (abyte and BitCheck) = HiBit THEN
  240.          Begin (* HiX *)
  241.          HiX := abyte and FiveBits ;
  242.          If ReadMchar(abyte) then else goto exit;
  243.          End ; (* HiX *)
  244.     IF (abyte and BitCheck) = LoXBit THEN
  245.          BEGIN  (* LoXBit *)
  246.          LoX := abyte and FiveBits;
  247.          X := ((HiX shl 5 + LoX) shl 2 ) + ExtraX ;
  248.          Y := ((HiY shl 5 + LoY) shl 2 ) + ExtraY ;
  249.          END ; (* LoXBit *)
  250. exit :
  251.       END ; (* Get X,Y Coordinates *)
  252. (* ------------------------------------------------------------------ *)
  253. Function GetInteger : integer ;
  254. var Hi1,Hi2,Low : byte ;
  255. label exit ;
  256.      Begin (* GetInteger *)
  257.      Hi1 := 0 ; Hi2 := 0 ; Low := 0 ;
  258.      If ReadMchar(abyte) then else goto exit;
  259.      If (abyte and $40) <> 0 then
  260.         begin (* Hi byte *)
  261.         Hi1 := (abyte and $3F);
  262.         If ReadMchar(abyte) then else goto exit;
  263.         if (abyte and $40) <> 0 then
  264.             begin (* Hi2 byte *)
  265.             Hi2 := Hi1 ;
  266.             Hi1 := abyte and $3F ;
  267.             If ReadMchar(abyte) then else goto exit ;
  268.             end ; (* Hi2 byte *)
  269.         end ; (* Hi byte *)
  270.         Low := abyte and $0F ;
  271.         if (abyte and $10) <> 0 then
  272.             GetInteger := Hi2 shl 10 + Hi1 shl 4 + Low
  273.                                  else
  274.             GetInteger := 0 - (Hi2 shl 10 + Hi1 shl 4 + Low) ;
  275. exit :
  276.      End ; (* GetInteger *)
  277. (* -------------------------------------------------------------------- *)
  278.     Function HLScolor(Hue,Lightness,Saturation : integer): integer;
  279.      (* This function returns a color value (0-15) for a given  *)
  280.      (*   Hue,Lightness,and Saturation                          *)
  281.      Const
  282.       HueTable : array [0..12] of integer =(Blue,magenta,red,brown,green,cyan,
  283.            LightBlue,lightmagenta,lightred,yellow,lightgreen,lightCyan,blue);
  284.         Begin (* HLS color *)
  285.     (* Check Lightness 100 for white , 0 for Black *)
  286.     if Lightness = 100 then HLSColor := white
  287.                        else
  288.       if Lightness =  0  then HLSColor := black
  289.                          else
  290.         if Saturation =  0 then  (* no color - GRAY *)
  291.                if Lightness >= 50 then HLSColor := LightGray
  292.                                   else HLSColor := DarkGray
  293.                            else
  294.         If Lightness < 50 then
  295.             HLSColor := HueTable[(Hue+30) div 60 ]
  296.                           else
  297.             HLSColor := HueTable[((Hue+30) div 60)+6];
  298.     End ; (* HLS color *)
  299. (* ------------------------------------------------------------------------ *)
  300.     Function PaletteIndex ( Color : shortint) : shortint ;
  301.     (* This function returns the PaletteIndex for a given color.          *)
  302.     (* If the color is not found in the Palette, the index is set to one. *)
  303.     Var Pal : PaletteType ;
  304.         i : shortint ;
  305.     Label exit ;
  306.     Begin (* PaletteIndex *)
  307.     GetPalette(Pal);
  308.     For i := 0 to Pal.Size-1 do
  309.        If Pal.Colors[i] = Color then goto exit ;
  310.     i := 1 ;
  311. Exit :
  312.     PaletteIndex := i ;
  313.     End ; (* PaletteIndex *)
  314. (* ------------------------------------------------------------------------ *)
  315.     Procedure GIN ;
  316.     var Done      : boolean ;
  317.         XGin,YGin : integer ;
  318.         SaveColor : shortint ;
  319.     Begin  (* GIN - Graphics INput *)
  320.     Done := false;
  321.       repeat
  322.          begin (* move cursor *)
  323.          SaveColor := GetColor ;
  324.          SetColor(PaletteIndex(GINcolor));
  325.          CrossHair(CursorX, CursorY);  {draw it}
  326.          REPEAT UNTIL KeyChar(abyte,bbyte);
  327.          CrossHair(CursorX, CursorY);  {erase it}
  328.            if abyte = 0 then
  329.               begin {special key}
  330.               case bbyte of
  331.               $48: begin {up arrow}
  332.                    CursorY := CursorY + 1 ;
  333.                    if CursorY >= YDim then  CursorY := (YDim - 1) ;
  334.                    end;  {up arrow}
  335.               $4B: begin {left arrow}
  336.                    CursorX := CursorX - 1 ;
  337.                    if CursorX < 0 then CursorX := 0;
  338.                    end ; {left arrow}
  339.               $4D: begin {right arrow}
  340.                    CursorX := CursorX + 1 ;
  341.                    if CursorX >= XDim then CursorX := (XDim - 1) ;
  342.                    end; {right arrow}
  343.               $50: begin {down arrow}
  344.                    CursorY := CursorY - 1 ;
  345.                    if CursorY < 0 then CursorY := 0;
  346.                    end; {down arrow}
  347.               $4F: begin {END}
  348.                    Done := true;
  349.                    SendChar($0D);
  350.                    end; {END}
  351.                         else
  352.                             {not recognized}
  353.                end (* of case *);
  354.                end { special key }
  355.                               else
  356.          begin (* send cursor location *)
  357.          SendChar(abyte);
  358.          if tek4010 then
  359.               begin (* TEK4010 GIN *)
  360.               XGin := Round(CursorX / XScale) shr 2 ;
  361.               SendChar((XGin shr 5) or Bit6 ) ;      (* Hi X *)
  362.               SendChar((XGin and FiveBits) or Bit6); (* Lo X *)
  363.               YGin := Round(CursorY / YScale) shr 2 ;
  364.               SendChar((YGin shr 5) or Bit6 ) ;      (* Hi Y *)
  365.               SendChar((YGin and FiveBits) or Bit6); (* Lo Y *)
  366.               SendChar($0D);
  367.               Done := True;
  368.               end  (* TEK4010 GIN *)
  369.                     else
  370.               begin (* TEK4100 GIN *)
  371.               YGin := Round((CursorY / YScale) * (4096 / windowY));
  372.               XGin := Round((CursorX / XScale) * (4096 / windowX));
  373.               SendChar(((YGin shr 7) and FiveBits) or Bit6); (* Hi Y *)
  374.               SendChar(((YGin and $03) shl 2) or
  375.                        (XGin and $03) or $60 );             (* Extra bits *)
  376.               SendChar(((YGin shr 2) and FiveBits) or $60 ); (* Lo Y *)
  377.               SendChar(((XGin shr 7) and FiveBits) or Bit6); (* Hi X *)
  378.               SendChar(((XGin shr 2) and FiveBits) or $40 ); (* Lo X *)
  379.               SendChar($0D);
  380.               Done := True;
  381.               end  (* TEK4100 GIN *)
  382.          end; (* send cursor location *)
  383.       end until Done;  (* move cursor *)
  384.       SetColor(SaveColor);
  385.     End ; (* GIN - Graphics INput *)
  386.  
  387.          Function PNumber (var abyte : byte) : integer ;
  388.           var Num  : integer ;
  389.               Begin (* PNumber *)
  390.               Num := 0  ;
  391.               While chr(abyte) in ['0'..'9']  do
  392.                    Begin (* get number *)
  393.                    Num := (Num * 10) + (abyte-$30) ;
  394.                    If ReadMchar(abyte) then ;
  395.                    End ; (* get number *)
  396.               PNumber := Num ;
  397.               End ; (* PNumber *)
  398.  
  399. (* ==================== Graphic Escape State ======================= *)
  400. Procedure TekEscapeSeq ;
  401. var  Pn      : array [1..10] of Integer ;
  402.      i,j,k   : integer ;
  403.      tempstr : string[3] ;
  404. label getnum,NextNum,DoCase,exit ;
  405.  
  406.     Begin (* Graphic Escape State *)
  407.      (*    savescreen^ := GraphScreen^ ; *)
  408.      (*   GetImage(0,0,Xdim,Ydim,SaveScreenP^);  *)
  409.     If ReadMchar(abyte) then else goto exit;
  410.            case chr(abyte) of
  411.     FF :     (* PAGE *)
  412.               begin
  413.               newgraph := true ;
  414.          (*     repeat until keypressed ;
  415.               achar := readkey ;        *)
  416.               end ;
  417.     SB :     (* Enable 4010 GIN *)
  418.              GIN ;
  419.     CR :     outtext(' UNKNOWN ') ; (* unknown *)
  420.     '[':  Begin (* Left square bracket *)
  421.           SetTextStyle(SmallFont,0,4) ;
  422.              If ReadMchar(abyte) then
  423.                CASE chr(abyte) of   (* Second level *)
  424.                  'A': CursorUp ;
  425.                  'B': CursorDown ;
  426.                  'C': CursorRight ;
  427.                  'D': CursorLeft  ;
  428.                  'J': ; (* Erase End of Display *)
  429.                  'K': ; (* Erase End of Line *)
  430.                  '?': If ReadMchar(abyte) then
  431.                         goto Getnum; (* Modes  *)
  432.                  'f',
  433.                  'H': Moveto(1,1);  (* Cursor Home *)
  434.                  'g': ; (* Cleartab *)
  435.                  '}',
  436.                  'm': begin (* Normal Video - Exit all attribute modes *)
  437.                       SetColor(LightGray);
  438.                       end ; (* Normal Video - Exit all attribute modes *)
  439.                  'r': begin (* Reset Margin *)
  440.                       Moveto(1,1);
  441.                       end ; (* Reset Margin *)
  442.  
  443.                  'c','h','l','n',
  444.                  'x': Begin Pn[1] := 0 ; Goto DoCase ; End ;
  445.                  ';': Begin Pn[1] := 0 ; k := 1 ; Goto nextnum ; End ;
  446.                 else  (* Pn - got a number *)
  447. Getnum:              Begin (* Esc [ Pn...Pn x   functions *)
  448.                      Pn[1] := PNumber(abyte);
  449.                      k := 1 ;
  450. Nextnum:             While abyte = ord(';') do
  451.                         Begin (* get Pn[k] *)
  452.                         If ReadMchar(abyte) then
  453.                         If chr(abyte) = '?' then
  454.                            If ReadMchar(abyte) then ; (* Ignore '?'  *)
  455.                         k:=k+1 ;
  456.                         Pn[k] := PNumber(abyte);
  457.                         End  ; (* get Pn[k] *)
  458.                      Pn[k+1] := 1 ;
  459. DoCase:              CASE chr(abyte) of (* third level *)
  460.                         'A': MoveTo(GetX,GetY-Pn[1]) ;  { Cursor Up   }
  461.                         'B': MoveTo(GetX,GetY+Pn[1]) ;  { Cursor Down }
  462.                         'C': MoveTo(GetX+Pn[1],GetY) ;  { Cursor Right}
  463.                         'D': MoveTo(GetX-Pn[1],GetY) ;  { Cursor Left }
  464.                         'f',
  465.                         'H': Begin (* Direct cursor address *)
  466.                              If Pn[2] = 0 then Pn[2] := 1 ;
  467.                              If Pn[2] > 80 then Pn[2] := 80 ;
  468.                              Moveto(Pn[2]*(XDim div 80),Pn[1]*(Ydim div 24));
  469.                              End ;(* Direct cursor address *)
  470.                         'c': Begin (* Device Attributes *)
  471.                              (* Send  Esc[?1;0c *)
  472.                              Sendchar(Esc); Sendchar(ord('['));
  473.                              Sendchar(ord('?')); Sendchar(ord('1'));
  474.                              Sendchar(ord(';')); Sendchar(ord('0'));
  475.                              Sendchar(ord('c'));
  476.                              End ; (* Device Attributes *)
  477.                         'g': (* clear tabs *) ;
  478.                         'h': (* Set Mode *) ;
  479.                         'l': (* Reset Mode *) ;
  480.                         'i': Begin (* Printer Screen  on / off *)
  481.                              End ;  (* Printer Screen  on / off *)
  482.  
  483.                         'q': FatCursor(Pn[1]=1); (* for series/1 insert mode *)
  484.                         'n': If Pn[1] = 5 then
  485.                                   Begin (* Device Status Report *)
  486.                                   (* Send  Esc[0n *)
  487.                                   Sendchar(Esc);Sendchar(ord('['));
  488.                                   Sendchar(ord('0'));Sendchar(ord('n'));
  489.                                   End   (* Device Status Report *)
  490.                                        else
  491.                              If Pn[1] = 6 then
  492.                                   Begin (* Cursor Position Report *)
  493.                                   Sendchar(Esc);Sendchar(ord('['));
  494.                                   STR(WhereY,tempstr);     (* ROW *)
  495.                                   Sendchar(ord(tempstr[1]));
  496.                                   If length(tempstr)=2 then
  497.                                        Sendchar(ord(tempstr[2]));
  498.                                   Sendchar(ord(';'));
  499.                                   STR(WhereX,tempstr);     (* COLUMN *)
  500.                                   Sendchar(ord(tempstr[1]));
  501.                                   If length(tempstr) = 2 then
  502.                                        Sendchar(ord(tempstr[2]));
  503.                                   Sendchar(ord('R'));
  504.                                   End ; (* Cursor Position Report *)
  505.                         'x': If Pn[1]<=1 then
  506.                               Begin (* Request terminal Parameters *)
  507.                               Sendchar(Esc); Sendchar(ord('['));
  508.                               If Pn[1] = 0 then Sendchar(ord('2'))
  509.                                            else Sendchar(ord('3')); (* sol *)
  510.                               Sendchar(ord(';'));  (* parity *)
  511.                               If parity = OddP  then Sendchar(ord('4'))
  512.                                                 else
  513.                               If parity = EvenP then Sendchar(ord('5'))
  514.                                                 else Sendchar(ord('1')) ;
  515.                               Sendchar(ord(';'));
  516.                               Sendchar(ord('2'));   (* nbits *)
  517.                               Sendchar(ord(';'));
  518.                               For j := 1 to 2 do
  519.                                  Begin (* Xspeed ,Rspeed *)
  520.                                    Case baudrate of
  521.                               300 : begin Sendchar(ord('4'));
  522.                                     Sendchar(ord('8')); end ;
  523.                               600 : begin Sendchar(ord('5'));
  524.                                     Sendchar(ord('6')); end ;
  525.                              1200 : begin Sendchar(ord('6'));
  526.                                     Sendchar(ord('4')); end ;
  527.                              2400 : begin Sendchar(ord('8'));
  528.                                     Sendchar(ord('8')); end ;
  529.                              4800 : begin Sendchar(ord('1'));
  530.                                     Sendchar(ord('0'));
  531.                                     Sendchar(ord('4')); end ;
  532.                              9600 : begin Sendchar(ord('1'));
  533.                                     Sendchar(ord('1'));
  534.                                     Sendchar(ord('2')); end ;
  535.                             19200 : begin Sendchar(ord('1'));
  536.                                     Sendchar(ord('2'));
  537.                                     Sendchar(ord('0')); end ;
  538.                                    end; (* case *)
  539.                                 Sendchar(ord(';'));
  540.                                 End ;  (* Xspeed ,Rspeed *)
  541.  
  542.                              Sendchar(ord('1'));  (* clkmul *)
  543.                              Sendchar(ord(';'));
  544.                              Sendchar(ord('0'));  (* flags *)
  545.                              Sendchar(ord('x'));
  546.                              End ; (* Request terminal Parameters *)
  547.                         'm',
  548.                         '}': For j := 1 to k do
  549.                              Case Pn[j] of      (* Field specs *)
  550.                              0: begin (* Normal *)
  551.                                 SetColor(LightGray) ;
  552.                                 end ;
  553.                              1: begin (* High Intensity *)
  554.                                 SetColor(White) ;
  555.                                 end ;
  556.                              4: SetColor(LightBlue) ;   (* Underline *)
  557.  
  558.                              5: begin (* Blink *)
  559.                                 end ;
  560.                              7: begin (* Reverse *)
  561.                                 end ;
  562.                              8: Begin (* Invisible *)
  563.                                  SetColor(Black);
  564.                                  SetBkColor(Black);
  565.                                  end ;
  566.                             30: SetColor(Black);
  567.                             31: SetColor(Red);
  568.                             32: SetColor(Green);
  569.                             33: SetColor(brown);
  570.                             34: SetColor(Blue);
  571.                             35: SetColor(Magenta);
  572.                             36: SetColor(Cyan);
  573.                             37: SetColor(Lightgray);
  574.  
  575.                             40: SetBkColor(Black);
  576.                             41: SetBkColor(Red);
  577.                             42: SetBkColor(Green);
  578.                             43: SetBkColor(Brown);
  579.                             44: SetBkColor(Blue);
  580.                             45: SetBkColor(Magenta);
  581.                             46: SetBkColor(Cyan);
  582.                             47: SetBkColor(LightGray);
  583.                              End ; (* case of Field specs *)
  584.                         'r': Begin  (* set margin *)
  585.                              End ; (* Set margin *)
  586.                         'J': Case Pn[1] of
  587.                              0:  ; (* clear to end of screen *)
  588.                              1:  ; (* clear to beginning *)
  589.                              2:  ;   (* clear all of screen *)
  590.                              End ; (*  J - Pn Case *)
  591.                         'K': Case Pn[1] of
  592.                              0:  ; (* clear to end of line *)
  593.                              1:  ; (* clear to beginning *)
  594.                              2:  ; (* clear line *)
  595.                              End ; (*  J - Pn  Case *)
  596.                         'L': For i := 1 to Pn[1] do (* Insert Line *) ;
  597.                         'M': For i := 1 to Pn[1] do (* Delete Line *) ;
  598.                         '@': For i := 1 to Pn[1] do (* InsertChar *)  ;
  599.                         'P': For i := 1 to Pn[1] do (* DeleteChar *)  ;
  600.                      End ; (* Case third level *)
  601.                      End ; (* Esc [ Pn...Pn x   functions *)
  602.  
  603.                End ; (* second level Case *)
  604.               End ; (* Left square bracket *)
  605.  
  606.     '%':     Begin (* Select Code *)
  607.               If ReadMchar(abyte) then else goto exit ;
  608.               if abyte = ord('!') then
  609.                  begin (* get code *)
  610.                  If ReadMchar(abyte) then else goto exit;
  611.                  case chr(abyte) of
  612.               '0' : Begin
  613.                     TekState := True ;     { TEK  }
  614.                     Ysize := 4096 ;
  615.                     Yscale := YDim / Ysize ;
  616.                     End ;
  617.               '1' ,                        { ANSI }
  618.               '2' ,                        { EDIT }
  619.               '3' : TekState := false ;    { VT52 }
  620.                   end ; (* case *)
  621.                  end ; (* get code *)
  622.              End ; (* Select Code *)
  623.     '#':      (* Report syntax Mode *) ;
  624.  
  625.     '8',
  626.     '9',
  627.     ':',
  628.     ';':      (* Set 4014 Alpha text size *) ;
  629.  
  630.     CN :      (* Enter Bypass Mode *) ;
  631.     EB :      (* 4010 Hardcopy *) ;
  632.     EQ :      (* Report 4010 Status *) ;
  633.  
  634.     'I' :     Begin (* I cases *)
  635.               If ReadMchar(abyte) then else goto exit ;
  636.               Case chr(abyte) of
  637.               'A' : { set pick Aperture } ;
  638.               'C' : { set GIN Cursor } ;
  639.               'D' : { Disable GIN }
  640.                     GINenable := False ;
  641.               'E' : Begin { Enable GIN }
  642.                     write(chr(bel));
  643.                     GINenable := True ;
  644.                     GIN ;
  645.                     End ; { Enable GIN }
  646.               'F' : Begin { Set GIN stroke Filtering }
  647.                     DevFunCode := GetInteger ;
  648.                     DistanceFilter := GetInteger ;
  649.                     TimeFilter := GetInteger ;
  650.                     End ; { Set GIN stroke Filtering }
  651.               'G' : { Set GIN Gridding } ;
  652.               'I' : { Set GIN Inking } ;
  653.               'L' : { Set report max Line length } ;
  654.               'M' : { set report EOM frequency } ;
  655.               'P' : { report GIN point } ;
  656.               'Q' : { report Terminal settings } ;
  657.               'R' : { set GIN rubberbanding } ;
  658.               'S' : { set report signature characters } ;
  659.               'V' : { set GIN area } ;
  660.               'W' : { set GIN Window } ;
  661.               'X' : { set GIN display start Point } ;
  662.               end ; (* I sub cases *)
  663.               End ; (* I cases *)
  664.  
  665.     'J' :     Begin (* J cases *)
  666.               If ReadMchar(abyte) then else goto exit ;
  667.               Case chr(abyte) of
  668.               'C' : { Copy } ;
  669.               'Q' : { report device status } ;
  670.               end ; (* J subcases *)
  671.               End ; (* J cases *)
  672.  
  673.     'K' :     Begin (* K cases *)
  674.               If ReadMchar(abyte) then else goto exit ;
  675.               Case chr(abyte) of
  676.               'A' : Begin { enable dialog area }
  677.                     DAenable := (GetInteger = 1) ;
  678.                     End ; { enable dialog area }
  679.               'B' : { set tab stops } ;
  680.               'C' : { cancel } ;
  681.               'D' : { define macro } ;
  682.               'E' : { set echo } ;
  683.               'F' : { lfcr } ;
  684.               'H' : { hardcopy } ;
  685.               'I' : { ignore deletes } ;
  686.               'L' : { lock keyboard } ;
  687.               'N' : Begin { renew view }
  688.                     ViewNumber := GetInteger ;
  689.                     ClearDevice ;
  690.                     End ; { renew view }
  691.               'O' : { define nonvolatile macro } ;
  692.               'Q' : { report errors } ;
  693.               'R' : { crlf } ;
  694.               'S' : { set snoopy mode } ;
  695.               'T' : Begin { set error threshold }
  696.                     ErrorLevel := GetInteger ; (* valid values 0-4 *)
  697.                     End ; { set error threshold }
  698.  
  699.               'U' : { save nonvolatile parameters } ;
  700.               'V' : { reset } ;
  701.               'W' : { enable keyboard expansion } ;
  702.               'X' : { expand macro } ;
  703.               'Y' : { set key execte character } ;
  704.               'Z' : { set edit characters } ;
  705.               end ; (* K subcases *)
  706.               End ; (* K cases *)
  707.  
  708.     'L' :     Begin (* L cases *)
  709.               If ReadMchar(abyte) then else goto exit ;
  710.               Case chr(abyte) of
  711.               'B' : { set dialog area buffer size } ;
  712.               'E' :  Begin { End Panel }
  713.                      Line ( Round(LastX * Xscale),Round(LastY * Yscale),
  714.                            Round(BeginPanelX  * Xscale),
  715.                            Round(BeginPanelY  * Yscale) );
  716.                     FillPoly(Pi,PolyGon) ;
  717.                     BeginPanel := False ;
  718.                     End ; { End panel }
  719.               'F' : Begin { Move }
  720.                     If ReadMchar(abyte) then else goto exit;
  721.                     GetCoord(X1,Y1);
  722.                     LastX := X1 * (4096 div windowx) ;
  723.                     LastY := Ysize - (Y1 * (4096 div windowY)) ;
  724.                     End ; { Move }
  725.               'G' : Begin { draw }
  726.                     If ReadMchar(abyte) then else goto exit;
  727.                     GetCoord(X1,Y1);
  728.                     NewX := X1 * (4096 div windowx) ;
  729.                     NewY := Ysize - (Y1 * (4096 div windowy )) ;
  730.                     Line ( Round(LastX * Xscale),Round(LastY * Yscale),
  731.                            Round(NewX  * Xscale),Round(NewY  * Yscale) ) ;
  732.                     LastX := NewX;
  733.                     LastY := NewY;
  734.                     End ; { draw }
  735.               'H' : { draw marker } ;
  736.               'I' : { set dialog area index } ;
  737.               'L' : Begin { set dialog area lines }
  738.                     DAlines := GetInteger ;
  739.                     End ; { set dialog area lines }
  740.               'M' : { set dialog area write mode } ;
  741.               'P' : Begin { begin panel boundary }
  742.                     BeginPanel := True ;
  743.                     If ReadMchar(abyte) then else goto exit;
  744.                     GetCoord(X1,Y1);    { first point }
  745.                     BeginPanelX := X1 * (4096 div windowx) ;
  746.                     BeginPanelY := Ysize - (Y1 * (4096 div windowY)) ;
  747.                     LastX := BeginPanelX ;
  748.                     LastY := BeginPanelY ;
  749.                     Boundfillpat := GetInteger = 0  { use fill pattern }
  750.                                          ; { else Use current line style }
  751.                     PI := 1 ;
  752.                     PolyGon[pi].X := Round(BeginPanelX * xscale );
  753.                     PolyGon[pi].Y := Round(BeginPanelY * yscale );
  754.                     End ; { begin panel boundary }
  755.               'T' : Begin { graphic text }
  756.                     AlphaCnt := GetInteger ;
  757.                     if alphacnt > 255 then alphacnt := 255;
  758.                     For I := 1 to AlphaCnt do
  759.                         Begin
  760.                         If ReadMchar(abyte) then else goto exit;
  761.                         AlphaStr[I] := chr(abyte);
  762.                         End;
  763.                     AlphaStr[0] := Chr(AlphaCnt) ;
  764.                     OutTextXY(Trunc(LastX*Xscale),
  765.                               Trunc(LastY*Yscale)-textheight('X'),AlphaStr);
  766.                     AlphaStr := ' ';
  767.                     DrawVector := false ;
  768.                     End ; { graphic text }
  769.               'V' : Begin { set dialog area visibility }
  770.                     If ReadMchar(abyte) then else goto exit;
  771.                     DAvisibility :=  abyte = ord('1') ;
  772.                     End ; { set dialog area visibility }
  773.               'Z' : { clear dialog scroll } ;
  774.               end ; (* L subcases *)
  775.               End ; (* L cases *)
  776.  
  777.     'M' :     Begin (* M cases *)
  778.               If ReadMchar(abyte) then else goto exit ;
  779.               Case chr(abyte) of
  780.               'A' : Begin { set graphtext slant }
  781.                     GTslant := GetInteger ;
  782.                     End ; { set graphtext slant }
  783.               'B' : Begin { set background indices }
  784.                     GTbackindex := GetInteger ;
  785.                     GTdashindex := GetInteger ;
  786.                     End ; { set background indices }
  787.               'C' : Begin { set graph text size }
  788.                     GTwidth := GetInteger ;
  789.                     GTheight := GetInteger ;
  790.                     GTspacing := GetInteger ;
  791.                   SetUserCharSize((GTwidth+GTspacing)*(4096 div windowX),
  792.                       Round(22400/xdim),GTheight*Round(Ysize/windowY),
  793.                        Round(20000/ydim));
  794.                     SetTextStyle(SmallFont,0,UserCharSize) ;
  795.                     End ; { set graph text size }
  796.               'F' : Begin { set graph text font }
  797.                     GTFont := GetInteger ;
  798.                     End ; { set graph text font }
  799.               'G' : Begin { set graphics area writing mode }
  800.                     GAmode := (GetInteger = 1 ) ;
  801.                     End ; { set graphics area writing mode }
  802.               'I' : Begin { set pick id }
  803.                     PickId := GetInteger ; (* value 0 to 32767 *)
  804.                     End ; { set pick id }
  805.               'L' : Begin { set line index }
  806.                     LineIndex := GetInteger ; (* value 0 to 15 *)
  807.                     if LineIndex > 15 then LineIndex := 15 ;
  808.                     SetColor(LineIndex);
  809.                     End ; { set line index }
  810.               'M' : Begin { set line marker type }
  811.                     MarkerNumber := GetInteger ; (* value 0 to 10 *)
  812.                     End ; { set line marker type }
  813.               'N' : Begin { set character path }
  814.                     GTpath := GetInteger ; (* value 0 to 4 *)
  815.                     End ; { set character path }
  816.               'P' : Begin { select fill pattern }
  817.                     Fillpattern := GetInteger ;  (* value -15 to 174 *)
  818.                     If Fillpattern < 0 then
  819.                         SetFillStyle(1,-Fillpattern)
  820.                                        else
  821.                         SetFillStyle(Fillpattern,1);
  822.                     End ; { select fill pattern }
  823.               'Q' : Begin { set graph text precision }
  824.                     GTprecision := GetInteger ; (* value 1 or 2 *)
  825.                     End ; { set graph text precision }
  826.               'R' : Begin { set graph text rotation }
  827.                     Mantissa := GetInteger ; (* value -32767 to 32767 *)
  828.                     Exponent := GetInteger ;
  829.                  (*   GTRotation := (Mantissa * (2 ** Exponent); *)
  830.                     End ; { set graph text rotation }
  831.               'S' : Begin { UNKNOWN }
  832.                     Unknown1 := GetInteger ;
  833.                     Unknown2 := GetInteger ;
  834.                     Unknown3 := GetInteger ;
  835.                     End ;{ UNKNOWN }
  836.               'T' : Begin { set text index }
  837.                     TextIndex := GetInteger ; (* value 0 to 15 *)
  838.                     If TextIndex > 15 then TextIndex := 15 ;
  839.                     SetColor(TextIndex);
  840.                     End ; { set text index }
  841.               'V' : Begin  { set line style }
  842.                     LineStyle := GetInteger ; (* value 0 to 7 *)
  843.                     If LineStyle > 3 then
  844.                     SetLineStyle(4,pattern[linestyle and $03],normWidth)
  845.                                      else
  846.                     SetLineStyle(LineStyle,
  847.                                  pattern[linestyle and $03],normWidth);
  848.                     End ;  { set line style }
  849.                end ; (* M subcases *)
  850.               End ; (* M cases *)
  851.  
  852.     'N' :     Begin (* N cases *)
  853.               If ReadMchar(abyte) then else goto exit ;
  854.               Case chr(abyte) of
  855.               'B' : { set stop bits } ;
  856.               'C' : { set eom characters } ;
  857.               'D' : { set transmit delay } ;
  858.               'E' : { set eof string } ;
  859.               'F' : { set flagging mode } ;
  860.               'G' : Unknown1 := GetInteger ;  { UNKNOWN }
  861.               'K' : { set break time } ;
  862.               'L' : { set transmit limit } ;
  863.               'M' : { prompt mode } ;
  864.               'P' : { set parity } ;
  865.               'Q' : { set queue size } ;
  866.               'R' : { set baud rates } ;
  867.               'S' : { set prompt string } ;
  868.               'T' : { set eol string } ;
  869.               'U' : { set bypass cancel character } ;
  870.                end ; (* N subcases *)
  871.               End ; (* N cases *)
  872.  
  873.     'P' :     Begin (* P cases *)
  874.               If ReadMchar(abyte) then else goto exit ;
  875.               Case chr(abyte) of
  876.               'A' : { port assign } ;
  877.               'B' : { set port stop bits } ;
  878.               'E' : { set port eof string } ;
  879.               'F' : { set port flagging mode } ;
  880.               'I' : { map index to pen } ;
  881.               'L' : { plot } ;
  882.               'M' : { set port eol string } ;
  883.               'P' : { set port parity } ;
  884.               'Q' : { report port status } ;
  885.               'R' : { set port baud rate } ;
  886.               end ; (* P subcases *)
  887.               End ; (* P cases *)
  888.  
  889.     'Q' :     Begin (* Q cases *)
  890.               If ReadMchar(abyte) then else goto exit ;
  891.               Case chr(abyte) of
  892.               'A' : { set copy size } ;
  893.               'D' : { select hardcopy interface } ;
  894.               'L' : { set dialog hardcopy attributes } ;
  895.                end ; (* Q subcases *)
  896.               End ; (* Q cases *)
  897.  
  898.     'R' :     Begin (* R cases *)
  899.               If ReadMchar(abyte) then else goto exit ;
  900.               Case chr(abyte) of
  901.               'A' : { set view attribute } ;
  902.               'C' : { select view } ;
  903.               'D' : { set surface definitions } ;
  904.               'E' : { set border visibility } ;
  905.               'F' : Begin { set fixup level }
  906.                     FixLevel := GetInteger ;
  907.                     End ; { set fixup level }
  908.               'H' : { set pixel beam position } ;
  909.               'I' : { set surface visibility } ;
  910.               'J' : { lock viewing keys } ;
  911.               'K' : Begin { delete view }
  912.                     ViewNumber := GetInteger ;
  913.                     End ; { delete view }
  914.               'L' : { runlength write } ;
  915.               'N' : { set surface priority } ;
  916.               'P' : { raster write } ;
  917.               'Q' : { set view display cluster } ;
  918.               'R' : { rectangle fill } ;
  919.               'S' : { set pixel viewport } ;
  920.               'U' : Begin { begin pixel operation }
  921.                     PixSurface := GetInteger ;
  922.                     ALUmode := GetInteger ;
  923.                     BitsPerPixel := GetInteger ;
  924.                     End ; { begin pixel operation }
  925.               'V' : Begin { set view port }
  926.                     If ReadMchar(abyte) then else goto exit;
  927.                     GetCoord(X1,Y1);
  928.                     If ReadMchar(abyte) then else goto exit;
  929.                     GetCoord(X2,Y2) ;
  930.                     End ; { set view port }
  931.               'W' : Begin { set window }
  932.                     If ReadMchar(abyte) then else goto exit;
  933.                     GetCoord(X1,Y1);
  934.                     If ReadMchar(abyte) then else goto exit;
  935.                     GetCoord(X2,Y2) ;
  936.                     WindowX := X2-X1;
  937.                     WindowY := Y2-Y1;
  938.                     End ; { set window }
  939.               'X' : { pixel copy } ;
  940.                end ; (* R subcases *)
  941.               End ; (* R cases *)
  942.  
  943.     'S' :     Begin (* S cases *)
  944.               If ReadMchar(abyte) then else goto exit ;
  945.               Case chr(abyte) of
  946.               'A' : { set segment class } ;
  947.               'B' : { begin lower segment }
  948.                      SegmentNum := SegmentNum - 1 ;
  949.               'C' : { end segment } ;
  950.               'D' : { set segment detectablity } ;
  951.               'E' : Begin { begin new segment }
  952.                     SegmentNum := GetInteger ;
  953.                     End ; { begin new segment }
  954.               'H' : { set segment highlighting } ;
  955.               'I' : { set segment image transform } ;
  956.               'K' : Begin { delete segment }
  957.                     SegmentNum := GetInteger ;
  958.                     End ; { delete segment }
  959.               'L' : { set current matching class } ;
  960.               'M' : { set segment writing mode } ;
  961.               'N' : { begin higher segment }
  962.                     SegmentNum := SegmentNum + 1 ;
  963.               'O' : Begin { begin segment }
  964.                     OpenSegment := GetInteger ;
  965.                     End ; { begin segment }
  966.               'P' : { set pivot point } ;
  967.               'Q' : { report segment status } ;
  968.               'R' : { rename segment } ;
  969.               'S' : { set segment display priority } ;
  970.               'T' : Begin { begin graphtext character }
  971.                     If ReadMchar(abyte) then else goto exit;
  972.                     GTB_FontNumber := GetInteger ;
  973.                     If ReadMchar(abyte) then else goto exit;
  974.                     GTB_FontChar := abyte ;
  975.                     End ; { begin graphtext character }
  976.               'U' : { end graphtext character } ;
  977.               'V' : { set segment visibilty } ;
  978.               'X' : Begin { set segment position }
  979.                     SegmentNum := GetInteger ;
  980.                     If ReadMchar(abyte) then else goto exit;
  981.                     GetCoord(SGPosX,SGPosY);
  982.                     End ; { set segment position }
  983.                end ; (* S subcases *)
  984.               End ; (* S cases *)
  985.  
  986.     'T' :     Begin (* T cases *)
  987.               If ReadMchar(abyte) then else goto exit ;
  988.               Case chr(abyte) of
  989.               'B' : Begin { set background color }
  990.                     ColorCoord1 := GetInteger ;
  991.                     ColorCoord2 := GetInteger ;
  992.                     ColorCoord3 := GetInteger ;
  993.                     SetBKcolor(PaletteIndex(HLSColor(ColorCoord1,
  994.                                         ColorCoord2,ColorCoord3))) ;
  995.                     End ; { set background color }
  996.               'C' : Begin { set GIN cursor color }
  997.                     ColorCoord1 := GetInteger ;
  998.                     ColorCoord2 := GetInteger ;
  999.                     ColorCoord3 := GetInteger ;
  1000.                     GINcolor := PaletteIndex(HLSColor(ColorCoord1,
  1001.                                         ColorCoord2,ColorCoord3)) ;
  1002.                     End ; { set GIN cursor color }
  1003.               'D' : { set alpha cursor indices } ;
  1004.               'F' : { set dialog area color map } ;
  1005.               'G' : Begin { set surface color  map }
  1006.                     (* surfacenumber(-1to4) , numberofintegers (4),
  1007.                        colorindex(0-15),Hue,Lightness,Saturation *)
  1008.                     SurfaceNumber := GetInteger ;
  1009.                     ColorMixI := GetInteger ;
  1010.                     For I := 1 to ColorMixI do
  1011.                       ColorMix[I] := GetInteger ;
  1012.                     I := 1 ;
  1013.                     While I  < ColorMixI  do
  1014.                         Begin (* Set Color for Colorindex *)
  1015.                         (* ColorMix[I]   = ColorIndex *)
  1016.                         (* ColorMix[I+1] = Hue        *)
  1017.                         (* ColorMix[I+2] = Lightness  *)
  1018.                         (* ColorMix[I+3] = Saturation *)
  1019.                         SetPalette(ColorMix[I],
  1020.                          HLSColor(ColorMix[I+1],ColorMix[I+2],ColorMix[I+3]));
  1021.                         I := I + 4 ;
  1022.                         End ; (* Set Color for Colorindex *)
  1023.                     End ; { set surface color  map }
  1024.               'M' : Begin { set color mode }
  1025.                     ColorMode := GetInteger ;
  1026.                     ColorOverMode := GetInteger ;
  1027.                     GrayMode := GetInteger ;
  1028.                     End ; { set color mode }
  1029.               end ; (* T subcases *)
  1030.               End ; (* T cases *)
  1031.     '`','a','b','c','d','e','f','g','h','i','j','k','l','m','n','o' :
  1032.               Begin (* Set 4014 Line Style *)
  1033.               LineStyle := abyte - $60 ; (* value 0 to 15 *)
  1034.               If LineStyle>7 then LineStyle := LineStyle - 8 ;
  1035.                     If LineStyle > 3 then
  1036.               SetLineStyle(4,pattern[linestyle and $03],normWidth)
  1037.                                else
  1038.               SetLineStyle(LineStyle,pattern[linestyle and $03],normWidth);
  1039.               TEK4014Linestyle := true ;
  1040.               End ; (* Set 4014 Line Style *)
  1041.        else
  1042.    exit :
  1043.              End ; (* case abyte *)
  1044.          End ; (* Graphic Escape State *)
  1045. (* ================================================================= *)
  1046.  
  1047. Begin (* Tektronics Procedure *)
  1048.  (* delay(9000);   add delay to bypass 449 bug *)
  1049. TekState := true ;
  1050. if lastbyte = 0 then
  1051.     begin (* TEK4100 color *)
  1052.     TEK4010 := false ;
  1053.     Ysize := 4095 ;
  1054.    Case GraphDriver of
  1055.      CGA : Graphmode := CGAC0 ;
  1056.     MCGA : Graphmode := MCGAC0 ;
  1057.      EGA : Graphmode := EGAHi ;
  1058.    EGA64 : Graphmode := EGA64Hi ;
  1059.   EGAMono: Graphmode := EGAMonoHi ;
  1060. HercMono : Graphmode := HercMonoHi ;
  1061.   ATT400 : Graphmode := ATT400C0 ;
  1062.      VGA : Graphmode := VGALo ;
  1063.   PC3270 : Graphmode := PC3270Hi ;
  1064.     End ; (* case *)
  1065.     end   (* TEK4100 color *)
  1066.                 else
  1067.     begin (* TEK4010 mono *)
  1068.     abyte := lastbyte ;
  1069.     Tek4010 := true ;
  1070.     Ysize := 780 * 4 ;
  1071.    Case GraphDriver of
  1072.      CGA : Graphmode := CGAHi ;
  1073.     MCGA : Graphmode := MCGAHi ;
  1074.      EGA : Graphmode := EGAHi ;
  1075.    EGA64 : Graphmode := EGA64Hi ;
  1076.   EGAMono: Graphmode := EGAMonoHi ;
  1077. HercMono : Graphmode := HercMonoHi ;
  1078.   ATT400 : Graphmode := ATT400Hi ;
  1079.      VGA : Graphmode := VGAHi ;
  1080.   PC3270 : Graphmode := PC3270Hi ;
  1081.     End ; (* case *)
  1082.     end ; (* TEK4010 mono *)
  1083. InitGraph(GraphDriver,GraphMode,' ') ;
  1084. result := graphresult ;
  1085.  if result <> 0 then
  1086.      begin
  1087.      writeln(' INIT graph failed ',result);
  1088.      goto exit ;
  1089.      end ;
  1090.     XDim := GetMaxX ;
  1091.     YDim := GetMaxY ;
  1092.     WindowX := 4095 ;
  1093.     WindowY := 4095 ;
  1094.     XScale := XDim / 4095 ;
  1095.     YScale := YDim / Ysize ;
  1096.  (*   getmem(SaveScreenP,ImageSize(0,0,Xdim,YDim) ) ; *)
  1097.  With palette do
  1098.    Begin (* palette *)
  1099.    Size := 16 ;
  1100.    Colors[0] := Black ;
  1101.    Colors[1] := White ;
  1102.    Colors[2] := Red ;
  1103.    Colors[3] := Green ;
  1104.    Colors[4] := Blue ;
  1105.    Colors[5] := Cyan ;
  1106.    Colors[6] := Magenta ;
  1107.    Colors[7] := Yellow ;
  1108.    Colors[8] := Brown ;
  1109.    Colors[9] := LightGreen ;
  1110.    Colors[10] := LightCyan ;
  1111.    Colors[11] := LightBlue ;
  1112.    Colors[12] := LightMagenta ;
  1113.    Colors[13] := LightRed ;
  1114.    Colors[14] := DarkGray ;
  1115.    Colors[15] := LightGray ;
  1116.    End ;
  1117.    if tek4010 then (* mono chrome *)
  1118.               else SetAllPalette(palette) ;
  1119.  
  1120. SetTextStyle(SmallFont,0,4) ;
  1121. If Newgraph then
  1122.     begin (* init new graph *)
  1123.     Newgraph := false ;
  1124.     WindowX := 4095 ;
  1125.     WindowY := 4095 ;
  1126.     XScale := XDim / 4095 ;
  1127.     YScale := YDim / Ysize ;
  1128.     CursorX := Xdim div 2 ;
  1129.     CursorY := Ydim div 2 ;
  1130.     end  (* init new graph *)
  1131.             else
  1132.    GraphScreen^ := Savescreen^ ;
  1133. (*    PutImage(0,0,SaveScreenP^,Normalput) ; *)
  1134. HiY := 0; LoY := 0; ExtraY := 0 ;
  1135. HiX := 0; LoX := 0; ExtraX := 0 ;
  1136. LastX := 0; LastY := 0;
  1137. NeedLoY := FALSE ;
  1138. DrawVector := FALSE ;
  1139. BeginPanel := FALSE ;
  1140. AlphaCnt := 0 ;
  1141. AlphaStr := '' ;
  1142. While TekState Do
  1143.     Begin (* Tek4100 Emulation *)
  1144.     If lastbyte = 0 then
  1145.       If ReadMchar(abyte) then
  1146.                           else goto exit
  1147.                     else lastbyte := 0 ;
  1148. Vectormode :
  1149.     If abyte = GS_ then
  1150.          Begin (* Vector Mode *)
  1151.          DrawVector := False ;
  1152. VectorContinue :
  1153.          If ReadMchar(abyte) then else goto exit ;
  1154.          While not (abyte in [esc,gs_,rs_,us_,fs_,sub,bel,can]) do
  1155.               Begin (* New coordinates *)
  1156.               GetCoord(X1,Y1);
  1157.               NewX := X1 * (4096 div windowx) ;
  1158.               NewY := Ysize -  (Y1 * (4096 div windowY)) ;
  1159.       (*       if Round(NewX * Xscale) > XDim then NewX := 1 ;
  1160.                if Round(Newy * Yscale) > YDim then NewY := 1 ; *)
  1161.               IF DrawVector or BeginPanel THEN
  1162.                Line ( Round(LastX * Xscale),Round(LastY * Yscale),
  1163.                       Round(NewX  * Xscale),Round(NewY  * Yscale) )
  1164.                                           ELSE
  1165.                    DrawVector := TRUE;
  1166.               LastX := NewX;
  1167.               LastY := NewY;
  1168.               If BeginPanel then
  1169.                   Begin { Record Poly Points }
  1170.                   Pi := Pi + 1 ;
  1171.                   PolyGon[pi].x := Round(LastX * Xscale) ;
  1172.                   PolyGon[pi].y := Round(LastY * Yscale) ;
  1173.                   End ; { Record Poly Points }
  1174.               If ReadMchar(abyte) then else goto exit;
  1175.               If abyte = gs_ then
  1176.                    Begin
  1177.                    DrawVector := false ;
  1178.                    If ReadMchar(abyte) then else goto exit ;
  1179.                    End ;
  1180.               End ; (* New Coordinates *)
  1181.          End ; (* Vector Mode *)
  1182.  
  1183.     If abyte = ESC then
  1184.          Begin (* esc sequence *)
  1185.          TEK4014LineStyle := false ; (* reset tek4014 flag *)
  1186.          TekEscapeSeq ;
  1187.          If TEK4014LineStyle then goto VectorContinue ;
  1188.          End  (* esc sequence *)
  1189.                    else
  1190.       If abyte = FS_ then
  1191.          Begin (* Marker Mode *)
  1192.          If ReadMchar(abyte) then else goto exit;
  1193.          GetCoord(X1,Y1) ;
  1194.          LastX := X1 * (4096 div windowx) ;
  1195.          LastY :=  Ysize -  (Y1 * (4096 div windowY)) ;
  1196.          (* make a mark *)
  1197.          Mark(Trunc(LastX*Xscale),Trunc(LastY*Yscale),MarkerNumber);
  1198.          End  (* Marker Mode *)
  1199.                      else
  1200.       If abyte = US_ then
  1201.          BEGIN {alphamode}
  1202.          If ReadMchar(abyte) then else goto exit ;
  1203.          While not (abyte in [esc,gs_,rs_,us_,fs_,ff_,sub,bel,can]) and
  1204.            (AlphaCnt < 255) do
  1205.               BEGIN  (* get alpha string *)
  1206.               AlphaStr := alphaStr + chr(abyte);
  1207.               AlphaCnt := AlphaCnt + 1;
  1208.               If ReadMchar(abyte) then else goto exit;
  1209.               END ;  (* get alpha string *)
  1210.          if AlphaCnt > 0 then
  1211.                OutTextXY(Trunc(LastX*Xscale),
  1212.                          Trunc(LastY*Yscale)-textheight('X'),AlphaStr);
  1213.          DrawVector := false ;
  1214.          AlphaCnt := 0 ;
  1215.          AlphaStr := '' ;
  1216.          Goto VectorMode ;
  1217.          END  {alphamode}
  1218.                      else
  1219.       If abyte = BEL then
  1220.          BEGIN { bell }
  1221.          writeln(chr(abyte));
  1222.          Repeat  until keypressed ;
  1223.          achar := readkey ;
  1224.          TekState := false ;
  1225.          END   { bell }
  1226.                      else
  1227.       If abyte = FF_ then
  1228.          BEGIN { Form Feed - New Screen }
  1229.          ClearDevice ;
  1230.          sound(2000); delay(1000); nosound ;
  1231.          END   { Form Feed - New Screen }
  1232.                       else
  1233.       begin
  1234.       If abyte = GS_ then goto VectorMode ;
  1235.       If abyte > $20 then outText(chr(abyte))
  1236.                      else
  1237.           if abyte = $0D then Moveto(0,gety)
  1238.                          else
  1239.              if abyte = $0A then Moveto(getx,gety+(YDim div 24)) ;
  1240.       end ;
  1241.     End ; (* Tek4100 Emulation  *)
  1242. exit :
  1243.     CloseGraph ;
  1244. End ; (* Tektronics Procedure *)
  1245. (* ----------------------------------------------------------------- *)
  1246.  
  1247.  (* Tek4100 Unit *)
  1248. Begin (* tek4100 *)
  1249. DetectGraph(GraphDriver,GraphMode);
  1250.    New(SaveScreen);
  1251.    If GraphResult = 0 then
  1252.    Case GraphDriver of
  1253.      CGA : Begin
  1254.            Graphmode := CGAHi ;
  1255.            GraphScreen := PTR($B800,0000);
  1256.            Graphics := ' - Tek4100  / CGA        ';
  1257.            End ;
  1258.     MCGA : Begin
  1259.            Graphmode := MCGAC0 ;
  1260.            GraphScreen := PTR($A000,0000);
  1261.            Graphics := ' - Tek4100  / MCGA       ';
  1262.            End ;
  1263.      EGA : Begin
  1264.            Graphmode := EGAHi ;
  1265.            GraphScreen := PTR($A000,0000);
  1266.            Graphics := ' - Tek4100  / EGA        ';
  1267.            End ;
  1268.    EGA64 : Begin
  1269.            Graphmode := EGA64Hi ;
  1270.            GraphScreen := PTR($A000,0000);
  1271.            Graphics := ' - Tek4100  / EGA64      ';
  1272.            End ;
  1273.   EGAMono: Begin
  1274.            Graphmode := EGAMonoHi ;
  1275.            GraphScreen := PTR($A000,0000);
  1276.            Graphics := ' - Tek4100  / EGAMono    ';
  1277.            End ;
  1278. HercMono : Begin
  1279.            Graphmode := HercMonoHi ;
  1280.            GraphScreen := PTR($B000,0000);
  1281.            Graphics := ' - Tek4100  / Hercules    ';
  1282.            End ;
  1283.   ATT400 : Begin
  1284.            Graphmode := ATT400C0 ;
  1285.            GraphScreen := PTR($B800,0000);
  1286.            Graphics := ' - Tek4100  / AT&T       ';
  1287.            End ;
  1288.      VGA : Begin
  1289.            Graphmode := VGAHi ;
  1290.            GraphScreen := PTR($A000,0000);
  1291.            Graphics := ' - Tek4100  / VGA        ';
  1292.            End ;
  1293.   PC3270 : Begin
  1294.            Graphmode := PC3270Hi ;
  1295.            GraphScreen := PTR($B800,0000);
  1296.            Graphics := ' - Tek4100  / PC3270     ';
  1297.            End ;
  1298.     End   (* case *)
  1299.            else {From 'If GraphResult = 0'}
  1300.               begin
  1301.               Sound (800); delay (50); nosound;
  1302.               Graphics := 'No graphics';
  1303.               WriteLn ('No graphic card.');
  1304.               end;
  1305. savescreen := graphscreen ;
  1306.  
  1307. End. (* Tek4100 Unit *)